perm filename ADIS.SAI[MF,DEK]3 blob
sn#554427 filedate 1981-01-10 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00014 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 This is magic code used in the PARC version of METAFONT
C00004 00003
C00006 00004
C00010 00005
C00014 00006
C00017 00007
C00020 00008
C00023 00009
C00026 00010
C00029 00011
C00031 00012
C00034 00013
C00036 00014
C00040 ENDMK
C⊗;
comment This is magic code used in the PARC version of METAFONT;
external integer !SKIP!;
define quotev = ⊂1⊃;
define replace = ⊂0⊃;
define lastregion = ⊂3⊃;
define nil = ⊂-1⊃;
define ttyl = ⊂64⊃;
define ttyr = ⊂576⊃;
define ttyb = ⊂20⊃;
define ttyt = ⊂240⊃;
define bitmapl = ⊂64⊃;
define bitmapr = ⊂576⊃;
define bitmapb = ⊂250⊃;
define bitmapt = ⊂730⊃;
define sdelt = ⊂2⊃;
define gray = ⊂12⊃;
define black = ⊂-1⊃;
define white = ⊂0⊃;
comment and more manifest;
define thisversion = ⊂15⊃;
define nfonts = ⊂15⊃;
define regionlength = ⊂34⊃;
define escapecharacter = ⊂3⊃;
define pdepositm = ⊂128⊃;
define pexaminem = ⊂129⊃;
define pdepositv = ⊂130⊃;
define pexaminev = ⊂131⊃;
define pdepositr = ⊂132⊃;
define pexaminer = ⊂133⊃;
define pinvalidate = ⊂134⊃;
define pflushinput = ⊂135⊃;
define psync = ⊂136⊃;
define pclose = ⊂137⊃;
define preset = ⊂138⊃;
define plineto = ⊂139⊃;
define pregionr = ⊂140⊃;
define pregionc = ⊂141⊃;
define pcursornudge = ⊂142⊃;
define ppress = ⊂142⊃;
define preadstate = ⊂144⊃;
define pcaretoff = ⊂145⊃;
define preadfont = ⊂146⊃;
define pstarttimer = ⊂147⊃;
define psyncbefore = ⊂148⊃;
define psyncafter = ⊂149⊃;
define pbackup = ⊂150⊃;
define pcurvesetup = ⊂151⊃;
define pcurveto = ⊂152⊃;
define pevent = ⊂160⊃;
define ptimeout = ⊂161⊃;
define pblocked = ⊂162⊃;
define pstate = ⊂163⊃;
define vversion = ⊂0⊃;
define vdisvloc = ⊂1⊃;
define vscreenbuf = ⊂2⊃;
define vcurrentregion = ⊂3⊃;
define vttyregion = ⊂4⊃;
define veanbleevents = ⊂10⊃;
define venabletimerstart = ⊂11⊃;
define venabletimerstop = ⊂12⊃;
define vtimerinterval = ⊂13⊃;
define vblocked = ⊂19⊃;
define veventtypechars = ⊂20⊃;
define vcaretregion = ⊂21⊃;
define vcaretrate = ⊂22⊃;
define vcaretdx = ⊂23⊃;
define vcaretdy = ⊂24⊃;
define vcaretpattern = ⊂25⊃;
define vescapechar = ⊂41⊃;
define vnregions = ⊂81⊃;
define vscreenymax = ⊂82⊃;
define vfonts = ⊂85⊃;
define vregions = ⊂100⊃ # nfonts+vfonts;
define rleft = ⊂16⊃;
define rright = ⊂17⊃;
define rtop = ⊂18⊃;
define rbottom = ⊂19⊃;
define ritalic = ⊂22⊃;
define rbold = ⊂23⊃;
define rscroll = ⊂24⊃;
define rbbcop = ⊂25⊃;
define rcurx = ⊂26⊃;
define rcury = ⊂27⊃;
define rcrx = ⊂28⊃;
define rlfy = ⊂29⊃;
define rfont = ⊂30⊃;
define rclearcolor = ⊂31⊃;
define rescapechar = ⊂32⊃;
define rtabx = ⊂33⊃;
integer adisifile, adisofile, adisijfn, adisojfn;
integer adisttysyncn, adiscurreg, adisttyreg, adisregionbase;
integer screenxmin, screenymin, screenxmax, screenymax, adisscreenbuf;
boolean forever;
integer array leftR, rightR, bottomR, topR[0:lastregion];
forward integer procedure adisINIT(string alto);
forward procedure adisCHECK;
forward procedure adisCLOSE;
forward procedure adisREGION(integer region);
forward procedure adisTTYREGION(integer region);
forward procedure adisLIMITS(integer l,r,b,t);
forward procedure adisSETCR(integer x);
forward procedure adisSETX(integer x);
forward procedure adisSETY(integer y);
forward procedure adisSETXY(integer x, y);
forward procedure adisREGIONOP(integer region, func, source, agray);
forward procedure adisDATA(integer region; integer array a; integer ylines, xwords);
forward procedure adisSYNCH;
forward integer procedure adisFILTERINPUT(integer op);
forward integer procedure adisEXAMINE(integer what, indexx, noconnc);
forward procedure adisSENDREGION(integer region);
forward procedure adisSETREGIONVAR(integer indexx, val;
boolean invalid, ttycheck);
forward procedure adisSETVAR(integer indexx, val);
forward procedure adisTTYBEFORE;
forward procedure adisTTYAFTER;
forward integer procedure adisEXAMINEM(integer addr, cnt);
forward procedure adisERROR(string er);
forward boolean procedure adisGETALTO(string nam);
forward string procedure adisNTOS(integer alto);
forward string procedure adisCONTROLLINGALTO;
forward integer procedure adisGETTAB(string tab; integer idx);
forward integer procedure adisVERIFYJFN(integer jfn; boolean fixit);
forward procedure adisCHECKCLOSEF(integer file, jfn);
forward string procedure adisCVSKT(integer jfn);
forward procedure adisBOUT(integer b);
forward integer procedure adisBIN;
forward procedure adisWOUT(integer b);
forward integer procedure adisWIN;
forward procedure adisFLUSH(boolean dosync);
forward procedure adisFLUSHINPUT;
forward procedure adisMARK(integer m);
forward boolean procedure adisINPUTAVAIL;
comment Initialization functions;
integer procedure adisINIT(string alto);
begin "initialization"
integer h1,h2,sa,sm;
if (vregions mod 2) neq 0 then
adisERROR("Regions must begin on even word boundary!");
adisCHECK;
if adisofile = nil then
begin
if alto = "" then alto ← adisCONTROLLINGALTO;
if alto neq "" then adisGETALTO(alto);
end
else begin
adisFLUSHINPUT;
adisSYNCH;
adisBOUT(preset);
end;
adisttysyncn ← 48;
adisregionbase ← adisEXAMINE(quotev,vdisvloc,nil) + vregions;
if (adisofile neq nil) land
(adisEXAMINE(quotev,vversion,nil) neq thisversion)
then adisERROR("Version number of running Chat is wrong");
screenxmin ← screenymin ← 0;
screenxmax ← 604;
if (adisofile neq nil)
then screenymax ← adisEXAMINE(quotev,vscreenymax,nil);
comment TTY region;
adisREGION(0);
adisSETVAR(vescapechar,escapecharacter);
rfcoc(65,h1,h2);
sm←3 lsh (34-2*escapecharacter);
sm←lnot sm;
sa←2 lsh (34-2*escapecharacter);
h1←h1 land sm;
h1←h1 lor sa;
sfcoc(65,h1,h2);
adisscreenbuf ← adisEXAMINE(quotev,vscreenbuf,nil);
adisLIMITS(ttyl,ttyr,ttyb,ttyt);
adisSETXY(ttyl+10,ttyt-14);
adisSETCR(ttyl+10);
adisTTYREGION(0);
adisFLUSH(false);
comment entire screen;
adisREGION(1);
adisLIMITS(screenxmin,screenxmax,screenymin,screenymax);
comment bitmap region;
adisREGION(2);
adisLIMITS(bitmapl,bitmapr,bitmapb,bitmapt);
comment region used for drawing borders
adisREGION(3);
comment set up the screen
comment paint entire screen gray;
adisREGION(1);
adisREGIONOP(1,replace+gray,nil,42405);
comment clear the tty region and paint borders;
adisREGION(0);
adisREGIONOP(0,replace+gray,nil,white);
adisREGION(3);
adisLIMITS(ttyl-sdelt-1,ttyl-1,ttyb-sdelt-1,ttyt+sdelt+1);
adisREGIONOP(3,replace+gray,nil,black);
adisLIMITS(ttyr+1,ttyr+sdelt+1,ttyb-sdelt-1,ttyt+sdelt+1);
adisREGIONOP(3,replace+gray,nil,black);
adisLIMITS(ttyl,ttyr,ttyb-sdelt-1,ttyb-1);
adisREGIONOP(3,replace+gray,nil,black);
adisLIMITS(ttyl,ttyr,ttyt+1,ttyt+sdelt+1);
adisREGIONOP(3,replace+gray,nil,black);
adisFLUSH(false);
comment clear the bitmap region and paint borders;
adisREGION(2);
adisREGIONOP(2,replace+gray,nil,white);
adisREGION(3);
adisLIMITS(bitmapl-sdelt-1,bitmapl-1,bitmapb-sdelt-1,bitmapt+sdelt+1);
adisREGIONOP(3,replace+gray,nil,black);
adisLIMITS(bitmapr+1,bitmapr+sdelt+1,bitmapb-sdelt-1,bitmapt+sdelt+1);
adisREGIONOP(3,replace+gray,nil,black);
adisLIMITS(bitmapl,bitmapr,bitmapb-sdelt-1,bitmapb-1);
adisREGIONOP(3,replace+gray,nil,black);
adisLIMITS(bitmapl,bitmapr,bitmapt+1,bitmapt+sdelt+1);
adisREGIONOP(3,replace+gray,nil,black);
adisFLUSH(true);
return(adisofile);
end "initialization";
procedure adisCHECK;
begin "check"
if (adisofile neq nil) then
begin
if (adisVERIFYJFN(adisijfn,nil) neq 2)
or (adisVERIFYJFN(adisojfn,nil) neq 2) then
begin
if (adisVERIFYJFN(adisijfn,nil) neq 0)
then adisCHECKCLOSEF(adisifile,adisijfn);
if (adisVERIFYJFN(adisojfn,nil) neq 0)
then adisCHECKCLOSEF(adisofile,adisojfn);
adisofile ← nil;
end;
end;
end "check";
procedure adisCLOSE;
begin "close"
adisCHECK;
if (adisofile neq nil) then
begin
adisBOUT(preset);
adisBOUT(pclose);
adisFLUSH(false);
CLOSF(adisofile);
CLOSF(adisifile);
adisojfn ← nil;
adisijfn ← nil;
end;
end "close";
procedure adisREGION(integer region);
begin "region"
if (region<0) or (region>lastregion)
then adisERROR("adisREGION: bad region number");
adiscurreg ← region;
adisSETVAR(vcurrentregion,adisregionbase+region*regionlength);
end "region";
procedure adisTTYREGION(integer region);
begin "ttyregion"
if (region<0) or (region>lastregion)
then adisERROR("adisTTYREGION: bad region number");
adisttyreg ← region;
adisTTYBEFORE;
adisSETVAR(vttyregion,adisregionbase+region*regionlength);
adisTTYAFTER;
end "ttyregion";
procedure adisLIMITS(integer l,r,b,t);
begin "limits"
if (adiscurreg = adisttyreg) then adisTTYBEFORE;
adisSETREGIONVAR(rleft,l,false,false);
leftR[adiscurreg] ← l;
adisSETREGIONVAR(rright,r,false,false);
rightR[adiscurreg] ← r;
adisSETREGIONVAR(rbottom,screenymax-b,false,false);
bottomR[adiscurreg] ← b;
adisSETREGIONVAR(rtop,screenymax-t,false,false);
topR[adiscurreg] ← t;
if (adiscurreg = adisttyreg) then adisTTYAFTER;
end "limits";
procedure adisSETCR(integer x);
begin "setcr"
adisSETREGIONVAR(rcrx,x,false,true);
end "setcr";
procedure adisSETX(integer x);
begin "setx"
adisSETREGIONVAR(rcurx,x,true,true);
end "setx";
procedure adisSETY(integer y);
begin "sety"
adisSETREGIONVAR(rcury,screenymax-y,true,true);
end "sety";
procedure adisSETXY(integer x, y);
begin "setxy"
adisSETX(x);
adisSETY(y);
end "setxy";
procedure adisREGIONOP(integer region, func, source, agray);
begin "regionop"
boolean con;
con ← (func land 12) = 12;
if adiscurreg = adisttyreg then adisTTYBEFORE;
adisBOUT(if con then pregionc else pregionr);
adisWOUT(func);
adisSENDREGION(region);
if not con then adisSENDREGION(source);
adisWOUT(agray);
if adiscurreg = adisttyreg then adisTTYAFTER;
end "regionop";
procedure adisDATA(integer region; integer array a; integer ylines, xwords);
begin "data"
comment this procedure to output the raster;
if (adisofile neq nil) then
begin integer fa, h, j;
fa ← adisscreenbuf + (leftR[region] div 16) +
38*(screenymax-topR[region]) + ylines*38 + 38;
for h ← 1 step 1 until ylines do
begin "yloop"
adisBOUT(pdepositm);
adisWOUT(fa-h*38);
adisBOUT(xwords);
for j ← xwords*h+1-xwords step 1 until xwords*h do
adisWOUT(a[j]);
end "yloop";
adisFLUSH(false);
end;
end "data";
procedure adisSYNCH;
begin "synch"
if (adisofile neq nil) then
begin
adisMARK(1);
adisBOUT(psync);
adisFLUSH(false);
adisFILTERINPUT(psync);
end;
end "synch";
integer procedure adisFILTERINPUT(integer op);
begin "filterinput" comment we always busy wait;
integer rcvop;
rcvop ← nil;
while true do
begin "busy"
rcvop ← adisBIN;
if rcvop=op then done "busy";
if rcvop=136 then begin end comment input length = 0;
else if (rcvop=131) or (rcvop=133) then comment input length = 2;
begin adisBIN; adisBIN end
else if (rcvop=160) or (rcvop=161) or (rcvop=162) then
begin
if rcvop=pevent then adisERROR("Queue opcode received");
comment see lisp code: add <rcvop adisRDEVENT> to queue;
end
else adisERROR("Unknown opcode received");
end "busy";
return(rcvop);
end "filterinput";
integer procedure adisEXAMINE(integer what, indexx, nconnc);
begin "examine"
integer opcode;
if (adisofile neq nil) then
begin
adisBOUT(opcode ← if (what = quotev) then pexaminev
else pexaminer);
if indexx > 255 then adisERROR("Bad index");
adisBOUT(indexx);
adisBOUT(pflushinput);
adisFLUSH(false);
adisFILTERINPUT(opcode);
return(adisWIN);
end
else return(if nconnc = nil then 0 else nconnc);
end "examine";
procedure adisSENDREGION(integer region);
begin "sendregion" comment check these computations!;
adisWOUT(leftR[region]);
adisWOUT(screenymax-topR[region]);
adisWOUT(rightR[region]-leftR[region]+1);
adisWOUT(topR[region]-bottomR[region]+1);
end "sendregion";
procedure adisSETREGIONVAR(integer indexx, val;
boolean invalid, ttycheck);
begin "setregionvar"
if (adisofile neq nil) then
begin
if ttycheck and (adiscurreg = adisttyreg) then
adisTTYBEFORE;
adisBOUT(pdepositr);
adisWOUT(val);
adisBOUT(indexx);
if invalid then adisBOUT(pinvalidate);
if ttycheck and (adiscurreg = adisttyreg) then
adisTTYAFTER;
end;
end "setregionvar";
procedure adisSETVAR(integer indexx, val);
begin "setvar"
if (adisofile neq nil) then
begin
adisBOUT(pdepositv);
adisWOUT(val);
adisBOUT(indexx);
end;
end "setvar";
procedure adisTTYBEFORE;
begin "ttybefore"
adisttysyncn ← if adisttysyncn = 57 then 48
else adisttysyncn+1;
if (adisofile neq nil) then
begin
adisBOUT(psyncbefore);
adisBOUT(adisttysyncn);
end;
end "ttybefore";
procedure adisTTYAFTER;
begin "ttyafter"
if (adisofile neq nil) then
begin
start!code
MOVEI 1, escapecharacter;
JSYS '74 # PBOUT;
MOVE 1, adisttysyncn;
JSYS '74 # PBOUT;
end;
adisBOUT(psyncafter);
adisFLUSH(false);
end;
end "ttyafter";
integer procedure adisEXAMINEM(integer addr, cnt);
begin "examinem"
adisBOUT(129);
adisWOUT(addr);
adisBOUT(cnt);
adisBOUT(135);
adisFLUSH(false);
adisFILTERINPUT(129);
return(adisWIN);
end "examinem";
procedure adisERROR(string er);
begin "error"
print(er);
end "error";
boolean procedure adisGETALTO(string nam);
begin "getalto"
integer helpflag;
string localname, sname;
sname ← nam&"+66";
adisofile ← GTJFN("PUP:."&sname,8589967360);
OPENF(adisofile,8589967360);
if !SKIP! neq 0 then adisofile ← nil;
if (adisofile = nil) then return(false);
adisojfn ← adisofile;
localname ← adisCVSKT(adisojfn);
adisifile ← GTJFN("PUP:"&localname&"!A."&sname,8590000128);
OPENF(adisifile,8590000128);
if !SKIP! neq 0 then adisifile ← nil;
if (adisifile = nil) then begin adisofile ← nil; return(false); end;
adisijfn ← adisifile;
return(true);
end "getalto";
string procedure adisNTOS(integer alto);
begin "ntos"
return("3#"&cvos(alto)&"#66");
end "ntos";
string procedure adisCONTROLLINGALTO;
begin "controllingalto"
integer ftty, ntty, term, nh;
start!code
JSYS '13 # GJINF;
MOVEM 4, term;
end;
ntty ← adisGETTAB("PUPPAR",0);
ftty ← ntty land 262143;
ntty ← (-ntty) lsh -18;
if ((term < ftty) or not (term < ftty+ntty)) then return("");
ftty ← 262143 land adisGETTAB("NVTPUP",term-ftty);
ntty ← (262143 land adisGETTAB("PUPFPT",ftty)) -
adisGETTAB("PUPPAR",1);
nh ← adisGETTAB("PUPBUF",ntty+1);
return(cvos(nh lsh -18)&"#"&cvos(nh land 262143)&"#0");
end "controllingalto";
integer procedure adisGETTAB(string tab; integer idx);
begin "gettab"
integer sx, c, tabn, rst;
label BAD;
sx ← 0;
for c ← 1 step 1 until length(tab) do
sx ← (sx lsh 6) + tab[c to c] - 32;
start!code
MOVE 1, SX;
JSYS '16 # SYSGT;
HRRZ 1, 2;
MOVEM 1, tabn;
end;
tabn ← tabn + (idx lsh 18);
start!code
MOVE 1, tabn;
JSYS '10 # GETAB;
JUMPA BAD;
SKIPA 0;
BAD: MOVE 1, nil;
MOVEM 1, rst;
end;
return(rst);
end "gettab";
integer procedure adisVERIFYJFN(integer jfn; boolean fixit);
begin "verifyjfn"
integer dsts, acc, i;
string xname;
boolean flag;
start!code
MOVE 1, jfn;
MOVEI 2, 0;
MOVEI 3, 0;
JSYS '24 # GTSTS;
MOVEM 2, acc;
end;
if acc geq 0 then return(0);
xname ← JFNS(jfn,8589934593);
flag ← true;
if (length(xname) neq length("PUP:")) then flag ← false;
for i ← 1 step 1 until length("PUP:") do
begin if xname[i to i] neq "PUP:"[i to i] then flag ← false end;
if not flag then return(0);
start!code
MOVE 1, jfn;
MOVEI 2, 0;
MOVEI 3, 0;
JSYS '145 # GDSTS;
MOVEM 2, dsts;
end;
if (dsts land 1610612736) neq 0 then
begin
if fixit then
start!code
MOVE 1, jfn;
MOVEI 2, 0;
JSYS '146 # SDSTS;
end;
end else return(1);
return(if ((dsts land 7) = 3) then 2 else 1);
end "verifyjfn";
procedure adisCHECKCLOSEF(integer file, jfn);
begin "checkclosef"
CLOSF(file);
if adisVERIFYJFN(jfn,nil) neq 0 then
adisERROR("PUP closing error");
end "checkclosef";
string procedure adisCVSKT(integer jfn);
begin "cvskt"
integer net, host, sock;
start!code
MOVE 1, jfn;
JSYS '275 # CVSKT;
SETOM 2;
HLRE 1, 2;
MOVEM 1, net;
HRRZ 1, 2;
MOVEM 1, host;
MOVEM 3, sock;
end;
return(cvos(net)&"#"&cvos(host)&"#"&cvos(sock));
end "cvskt";
procedure adisBOUT(integer b);
begin "bout"
start!code
MOVE 1, adisojfn;
MOVE 2, b;
JSYS '51 # BOUT;
end;
end "bout";
integer procedure adisBIN;
begin "bin"
integer byt;
start!code
MOVE 1, adisijfn;
JSYS '50 # BIN;
MOVEM 2, byt;
end;
return(byt);
end "bin";
procedure adisWOUT(integer b);
begin "wout"
start!code
MOVE 1, adisojfn;
MOVE 2, b;
ROT 2, -'10;
JSYS '51 # BOUT;
ROT 2, '10;
JSYS '51 # BOUT;
end;
end "wout";
integer procedure adisWIN;
begin "win"
return(256*adisBIN+adisBIN);
end "win";
procedure adisFLUSH(boolean dosync);
begin "flush"
if (adisofile neq nil) then
begin
if dosync then adisSYNCH
else start!code
MOVE 1, adisojfn;
MOVEI 2, '21;
JSYS '77 # MTOPR;
end;
end;
end "flush";
procedure adisFLUSHINPUT;
begin "flushinput"
integer foo;
while adisINPUTAVAIL do foo ← adisBIN;
end "flushinput";
procedure adisMARK(integer m);
begin "mark"
if (adisofile neq nil) then
start!code
MOVE 1, adisojfn;
MOVE 2, m;
MOVEI 2, 3;
JSYS '77 # MTOPR;
end;
end "mark";
boolean procedure adisINPUTAVAIL;
begin "inputavail"
boolean reply;
if (adisofile neq nil) then
start!code
MOVE 1, adisijfn;
JSYS '102 # SIBE;
SKIPA 1, true;
MOVE 1, false;
MOVEM 1, reply;
end;
return(reply);
end "inputavail";
preload_with true; safe boolean array adnotready[0:0];
integer array bp[0:7] # byte pointers for 4-bit groups;
integer bwd # buffer word used when converting from 36-bit to 32-bit format;
integer get # byte pointer for getting 4 bits and putting out 32;
internaldef ddxmin=-89,ddxmax=414,ddymin=-99,ddymax=380 # datadisk window;
comment $\\{ddxmin}-1$ and \\{ddxmax} should be congruent to 18, modulo 36;
comment we must have xrastmin+xpenmin≤ddxmin, ddxmax≤xrastmax+xpenmax,
yrastmin+ypenmin≤ddymin, ddymax≤yrastmax+ypenmax,
ddxmax-ddxmin<504, ddymax-ddymin<480;
internaldef ddn=5 # printing is confined to this many lines at bottom of screen;
procedure initdd;
begin integer k;
if adnotready[0] then
begin
adnotready[0]←false;
adisINIT("");
for k←0 thru 7 do bp[k]←point(4,bwd,4*k+7);
adisREGION(2);
adisREGIONOP(2,replace+gray,nil,white);
end;
end;
procedure cleardd;
begin
if adnotready[0] then return;
adisREGION(2);
adisREGIONOP(2,replace+gray,nil,white);
end;
internal procedure sbw(integer w);
begin
adisWOUT(w lsh -16); adisWOUT(w);
end;
internal procedure ddoutrast;
begin define ddscreen=2;
integer j,y,yl,yh,xl,xr,bytes,fra,yrlines,words;
if adnotready[0] then initdd;
xl←xleft max rcol(ddxmin); xr←xright min rcol(ddxmax);
yl←ylow max (yhigh-449); yh←yhigh;
yrlines←yh-yl+1;
fra ← adisscreenbuf +(leftR[ddscreen] div 16) +
38*(screenymax-topR[ddscreen])+yrlines*38+15*38;
adisREGION(2);
bytes←9*(xr-xl+1) # number of 4-bit bytes to transmit;
words←2*((bytes+7) div 8);
for y←yl thru yh do
begin integer xw; xw←xl*rspan+y;
get←point(4,rast[xw],-1);
adisBOUT(pdepositm);
adisWOUT(fra-(y-yl)*38);
adisBOUT(words);
bwd←0;
for j←0 thru bytes-1 do
begin dpb(ildb(get),bp[j land 7]) # deposit 4 bits into \\{bwd};
if (j land 7) = 7 then
begin sbw(bwd); bwd←0;
end;
if (j mod 9) = 8 then
begin xw←xw+rspan; get←point(4,rast[xw],-1);
end;
end;
if (bytes land 7) ≠ 0 then sbw(bwd) # deposit remaining bits;
end;
adisFLUSH(false);
end;